1 Imports
Code
library(ggplot2)
library(dplyr)
library(readxl)
library(micEcon)
library(stargazer)
library(gt)
library(tibble)
library(knitr)
library(plotly)Code
bg_color <- "#FCFCFC"2 Description des données
Le jeu de données appleProdFr86 utilisé dans le papier d’économétrie de Ivaldi et al. (1996) comprend des données transversales de production de 140 producteurs de pommes français datant de l’année 1986.
Code
apples <- read_excel("data/appleProdFr86.xlsx")| Colonnes | Description |
|---|---|
vCap |
Coûts associés au capital (foncier compris). |
vLab |
Coûts associés au travail (y compris la rémunération du travail familial non rémunéré). |
vMat |
Coûts des matières intermédiaires (plantations, engrais, pesticides, carburant, etc). |
qApples |
Indice de quantité des pommes produites. |
qOtherOut |
Indice de quantité de tous les autres outputs. |
qOut |
Indice de quantité de toute la production \(\Rightarrow 580000 \cdot (\text{qApples} + \text{qOtherOut})\) |
pCap |
Indice des prix du capital. |
pLab |
Indice des prix du travail. |
pMat |
Indice des prix des matières intermédiaires. |
pOut |
Indice des prix de la production globale. |
adv |
Distingue les producteurs qui sont conseillés par des laboratoires d’agronomie. |
2.1 Tableau descriptif
Ce tableau descriptif retrace les 10 premières observations et l’ensemble des variables associées dans le dataset.
Code
apples |>
head(n = 10) |>
gt() |>
tab_header(
title = md("**Producteurs de pommes 🍎**"),
subtitle = md("*140 producteurs* 🇫🇷 *(1986)*")
) |>
tab_source_note(
source_note = "Source: Ivaldi et al. (1996)"
) |>
tab_spanner(
label = "Costs",
columns = c("vCap", "vLab", "vMat")
) |>
tab_spanner(
label = "Price Index",
columns = c("pCap", "pLab", "pMat", "pOut")
) |>
tab_spanner(
label = "Quantity Index",
columns = c("qApples", "qOtherOut", "qOut")
) |>
tab_style(
style = list(
cell_fill(color = "lavenderblush")
),
location = cells_body(columns = c(vCap, vLab, vMat))
) |>
tab_style(
style = list(
cell_fill(color = "ivory")
),
location = cells_body(columns = c(qApples, qOtherOut, qOut))
) |>
tab_style(
style = list(
cell_fill(color = "aliceblue")
),
location = cells_body(columns = c(pCap, pLab, pMat, pOut))
) |>
fmt_number(suffixing = TRUE, n_sigfi = 2) |>
text_case_match(
"1.0" ~ fontawesome::fa("check"),
"0" ~ fontawesome::fa("xmark"),
.locations = cells_body(columns = adv)
) |>
tab_options(
table.background.color = bg_color
)| Producteurs de pommes 🍎 | ||||||||||||||
| 140 producteurs 🇫🇷 (1986) | ||||||||||||||
| N | Costs | Quantity Index | Price Index | adv | qCap | qLab | qMat | |||||||
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| vCap | vLab | vMat | qApples | qOtherOut | qOut | pCap | pLab | pMat | pOut | |||||
| 1 | 220K | 320K | 300K | 1.4 | 0.98 | 1.4M | 2.6 | 0.90 | 8.9 | 0.66 | 84K | 360K | 34K | |
| 2 | 130K | 190K | 260K | 0.86 | 1.1 | 1.1M | 3.3 | 0.75 | 6.4 | 0.72 | 40K | 250K | 41K | |
| 3 | 81K | 130K | 91K | 3.3 | 0.40 | 2.2M | 2.2 | 0.96 | 3.7 | 0.94 | 37K | 140K | 24K | |
| 4 | 34K | 110K | 60K | 0.44 | 0.44 | 510K | 1.6 | 1.3 | 3.2 | 0.60 | 21K | 83K | 19K | |
| 5 | 39K | 84K | 100K | 1.8 | 0.015 | 1.1M | 0.87 | 0.94 | 7.2 | 0.83 | 45K | 89K | 14K | |
| 6 | 120K | 520K | 580K | 8.5 | 0.43 | 5.2M | 1.0 | 0.96 | 9.6 | 1.4 | 120K | 550K | 60K | |
| 7 | 89K | 170K | 340K | 4.1 | 3.3 | 4.3M | 0.98 | 1.0 | 7.8 | 1.3 | 91K | 170K | 44K | |
| 8 | 92K | 200K | 130K | 2.2 | 1.1 | 1.9M | 1.0 | 0.92 | 5.0 | 0.62 | 89K | 220K | 25K | |
| 9 | 66K | 180K | 190K | 1.8 | 2.6 | 2.5M | 2.5 | 1.0 | 5.6 | 1.9 | 27K | 180K | 34K | |
| 10 | 94K | 140K | 82K | 1.6 | 0.45 | 1.2M | 0.98 | 0.64 | 5.6 | 0.49 | 95K | 220K | 15K | |
| Source: Ivaldi et al. (1996) | ||||||||||||||
3 Analyse exploratoire
ACP à faire ? pourrait être intéressant
Code
apples_num <- apples |>
select(-N)
cor <- apples_num |> cor()
fig <- plot_ly(
x = colnames(apples_num), y = colnames(apples_num),
z = cor, type = "heatmap", colors = "Greys"
)
figCode
fig <- plot_ly(x = apples$vCap, type = "histogram", nbinsx = 30, alpha = 0.6)
figCode
fig <- plot_ly(alpha = 0.6, nbinsx = 50)
fig <- fig %>% add_histogram(apples$vCap[apples$adv == 1], name = "advisory service")
fig <- fig %>% add_histogram(apples$vCap[apples$adv == 0], name = "not advisory service")
fig <- fig %>% layout(
barmode = "overlay",
yaxis = list(title = "Frequency"),
xaxis = list(title = "Values")
)
figCode
apples |>
select(qApples, adv) |>
group_by(adv) |>
summarise(mean = mean(qApples))# A tibble: 2 × 2
adv mean
<dbl> <dbl>
1 0 3.15
2 1 2.99
4 Fonction Cobb-Douglas
La forme est généralisée à \(N\) inputs.
\[y = A \prod_{k=1}^N x_k^{a_k}\]
Dans le cadre de cette étude comparative, nous avons 3 inputs :
qCap\(\Rightarrow\) la quantité de capitalqLab\(\Rightarrow\) la quantité de travailqMat\(\Rightarrow\) la quantité de matériaux
Nous obtenons donc la forme suivante :
\[q_{Out} = A\cdot q_{Cap}^\alpha \cdot q_{Lab}^\beta \cdot q_{Mat}^\gamma\]
Avec \(A, \alpha, \beta, \gamma \Rightarrow\) 4 paramètres à estimer.
On peut facilement linéariser la fonction, dès lors on obtient :
\[ \ln(q_{out}) = \ln(A) + \alpha \cdot \ln(q_{Cap}) + \beta \cdot \ln(q_{Lab}) + \gamma \cdot \ln(q_{Mat}) \]
Allen Elasticity of Substitution (AES)
\(\sigma_{\{\text{qCap, qLab, qMat}\}} = 1\)
Rappel : Si la fonction de production est Cobb-Douglas, alors on a normalement \(\hat\alpha + \hat\beta + \hat\gamma = 1\)
On peut tester cette hypothèse :
\[ \begin{cases} H_0 : \alpha + \beta + \gamma = 1\\ H_1 : \alpha + \beta + \gamma \neq 1\\ \end{cases} \]
Code
cd_prod_1 <- lm(log(qOut) ~ log(qCap) + log(qLab) + log(qMat), data = apples)
coefficients <- summary(cd_prod_1)$coefficients[, 1]
std_values <- summary(cd_prod_1)$coefficients[, 2]
pvalues <- summary(cd_prod_1)$coefficients[, 4]
cobb_douglas <- data.frame(cbind(coefficients, std_values, pvalues))
r2 <- round(summary(cd_prod_1)$r.squared, 3)
adj_r2 <- round(summary(cd_prod_1)$adj.r.squared, 3)
n <- nobs(cd_prod_1)Code
cobb_douglas |>
tibble() |>
add_column(description = c(
"- Constante du modèle",
"- Coefficient associé à la variable `qCap`",
"- Coefficient associé à la variable `qLab`",
"- Coefficient associé à la variable `qMat`"
), .before = coefficients) |>
add_column(names = c("$A$", "$\\alpha$", "$\\beta$", "$\\gamma$"), .before = coefficients) |>
add_column(significativite = case_when(
pvalues < 0.001 ~ "$***$",
pvalues < 0.05 ~ "$**$",
pvalues < 0.1 ~ "$*$",
.default = ""
)) |>
gt(rowname_col = "names") |>
cols_label(
description = md("**Description**"),
coefficients = md("**Coefficients**"),
std_values = md("**Ecart Type**"),
pvalues = md("**Pvalues**"),
significativite = md("**Significativité**")
) |>
fmt_markdown(columns = c(names, description, significativite)) |>
fmt_number(columns = c(coefficients, pvalues), decimals = 3) |>
fmt(columns = std_values, fns = function(std) {
paste("+/-", round(std, 3))
}) |>
# data_color(columns = coefficients) |>
tab_footnote(footnote = md(sprintf("*Observations* : %s", n))) |>
tab_footnote(footnote = md("***")) |>
tab_footnote(footnote = md(sprintf("$R^2=$ %s", r2))) |>
tab_footnote(footnote = md(sprintf("$R^2_{adj}=$ %s", adj_r2))) |>
tab_header(
title = md("**Fonction de production Cobb-Douglas**"),
subtitle = md("Variable dépendante : *qOut*")
) |>
tab_options(
table.background.color = bg_color
)| Fonction de production Cobb-Douglas | |||||
| Variable dépendante : qOut | |||||
| Description | Coefficients | Ecart Type | Pvalues | Significativité | |
|---|---|---|---|---|---|
\(A\) |
|
−2.064 | +/- 1.313 | 0.118 | |
\(\alpha\) |
|
0.163 | +/- 0.087 | 0.064 | \(*\) |
\(\beta\) |
|
0.676 | +/- 0.154 | 0.000 | \(***\) |
\(\gamma\) |
|
0.627 | +/- 0.126 | 0.000 | \(***\) |
| Observations : 140 | |||||
| |
|||||
| \(R^2=\) 0.594 | |||||
| \(R^2_{adj}=\) 0.585 | |||||
Code
# Estime une fonction Cobb Douglas avec l'argument linear
cd_prod <- translogEst(
"qOut",
c("qCap", "qLab", "qMat"),
apples,
linear = TRUE
)Code
makestars <- function(pvalues) {
return(
dplyr::case_when(
pvalues < 0.001 ~ "$***$",
pvalues < 0.05 ~ "$**$",
pvalues < 0.1 ~ "$*$",
.default = ""
)
)
}
gtgazer <- function(model, n_coef = 4, coefnames, description, title, bg_color) {
coefficients <- summary(model)$coefTable[1:n_coef, 1]
std_values <- summary(model)$coefTable[1:n_coef, 2]
pvalues <- summary(model)$coefTable[1:n_coef, 4]
signif <- makestars(pvalues)
r2 <- round(summary(model)$r2, 3)
adj_r2 <- round(summary(model)$r2bar, 3)
n <- summary(model)$nObs
dep_variable <- summary(model)$yName
coefnames <- coefnames
description <- description
reg_results <- data.frame(cbind(coefnames, description, coefficients, std_values, pvalues, signif)) |>
tibble() |>
mutate(across(c(coefficients, std_values, pvalues), as.numeric))
table <- reg_results |>
gt(rowname_col = "coefnames") |>
cols_label(
description = md("**Description**"),
coefficients = md("**Coefficients**"),
std_values = md("**Ecart Type**"),
pvalues = md("**Pvalues**"),
signif = md("**Significativité**")
) |>
fmt_markdown(columns = c(coefnames, signif, description)) |>
fmt_number(columns = c(coefficients, pvalues), decimals = 3) |>
fmt(columns = std_values, fns = function(std) {
paste("+/-", round(std, 3))
}) |>
tab_footnote(footnote = md(sprintf("*Observations* : %s", n))) |>
tab_footnote(footnote = md("***")) |>
tab_footnote(footnote = md(sprintf("$R^2=$ %s", r2))) |>
tab_footnote(footnote = md(sprintf("$R^2_{adj}=$ %s", adj_r2))) |>
tab_header(
title = md(title),
subtitle = md(sprintf("Variable dépendante : *%s*", dep_variable))
) |>
tab_options(
table.background.color = bg_color
)
return(table)
}Code
gtgazer(
cd_prod,
n_coef = 4,
coefnames = c("$A$", "$\\alpha$", "$\\beta$", "$\\gamma$"),
description = c(
"- Constante du modèle",
"- Coefficient associé à la variable `qCap`",
"- Coefficient associé à la variable `qLab`",
"- Coefficient associé à la variable `qMat`"
),
title = "**Fonction de production Cobb-Douglas**",
bg_color = bg_color
)| Fonction de production Cobb-Douglas | |||||
| Variable dépendante : qOut | |||||
| Description | Coefficients | Ecart Type | Pvalues | Significativité | |
|---|---|---|---|---|---|
\(A\) |
|
−2.064 | +/- 1.313 | 0.118 | |
\(\alpha\) |
|
0.163 | +/- 0.087 | 0.064 | \(*\) |
\(\beta\) |
|
0.676 | +/- 0.154 | 0.000 | \(***\) |
\(\gamma\) |
|
0.627 | +/- 0.126 | 0.000 | \(***\) |
| Observations : 140 | |||||
| |
|||||
| \(R^2=\) 0.594 | |||||
| \(R^2_{adj}=\) 0.585 | |||||
Code
summary(cd_prod$est)
Call:
lm(formula = as.formula(estFormula), data = estData)
Residuals:
Min 1Q Median 3Q Max
-1.67239 -0.28024 0.00667 0.47834 1.30115
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) -2.06377 1.31259 -1.572 0.1182
a_1 0.16303 0.08721 1.869 0.0637 .
a_2 0.67622 0.15430 4.383 2.33e-05 ***
a_3 0.62720 0.12587 4.983 1.87e-06 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 0.656 on 136 degrees of freedom
Multiple R-squared: 0.5943, Adjusted R-squared: 0.5854
F-statistic: 66.41 on 3 and 136 DF, p-value: < 2.2e-16
Code
apples <- apples |> mutate(cost = vCap + vLab + vMat)Code
# Estime une fonction Cobb Douglas avec l'argument linear
# translogCostEst("cost", "qOut", c("qCap", "qLab", "qMat"), apples)- Avec la fonction de cout on trouve 2.7 – à vérifier
Estimer des fonctions de cout, les rendements d’échelle, estimer la fonction CES, la leontieff généralisée, calculer le profit des producteurs, lien entre efficacité, optimalité, vérifier hétéroscédasticité.
Code
cobbDouglasCalc(c("qCap", "qLab", "qMat"), apples, coef(cd_prod)[1:4], coefCov = NULL, dataLogged = FALSE) 1 2 3 4 5 6 7
3211442.9 2484348.9 1198934.2 659255.2 657608.3 6440150.6 2289560.6
8 9 10 11 12 13 14
1941829.7 1643085.0 1393628.8 1065518.4 2532062.5 1142644.8 1990393.7
15 16 17 18 19 20 21
1804586.9 2486696.5 623801.8 4674844.6 652055.8 1602756.5 3585652.8
22 23 24 25 26 27 28
3105133.1 1962299.4 1894850.1 1730990.1 2028057.2 1236923.3 3120162.0
29 30 31 32 33 34 35
857551.9 1283936.8 1591240.6 1112374.7 1104836.2 1990082.5 2286930.2
36 37 38 39 40 41 42
1050671.7 670978.8 385308.3 617220.9 947210.5 1523069.4 1590208.7
43 44 45 46 47 48 49
1152166.4 874268.3 856786.7 1501912.2 812992.3 1433944.5 1169689.9
50 51 52 53 54 55 56
761120.5 655665.9 737223.4 623412.9 541717.9 1239529.1 1182383.1
57 58 59 60 61 62 63
1401808.7 628116.7 507950.3 2747396.1 539581.5 1055087.5 3550349.5
64 65 66 67 68 69 70
935872.0 1410581.5 5799225.5 4578344.7 2308627.1 5785802.2 8756920.8
71 72 73 74 75 76 77
936486.7 859620.4 940655.3 461623.9 848543.7 2309804.2 1241075.8
78 79 80 81 82 83 84
456956.7 723527.6 395900.6 692132.4 6173798.8 936641.2 6561521.0
85 86 87 88 89 90 91
3007107.9 4707504.1 1821147.0 1274546.0 1539352.9 10076301.8 1887415.3
92 93 94 95 96 97 98
1941222.6 3696158.0 6802400.4 1055932.4 23101792.2 1334995.9 1869797.5
99 100 101 102 103 104 105
3712233.4 1116260.1 4223297.1 4854943.6 1385925.9 1748553.8 2053107.4
106 107 108 109 110 111 112
1458847.1 2051602.9 643613.7 5267349.8 3902378.1 1836245.8 2455677.3
113 114 115 116 117 118 119
1624723.3 1560690.4 953841.4 710120.9 1658775.2 1321024.4 1312615.0
120 121 122 123 124 125 126
2743290.7 1054216.7 1320798.9 1262051.7 2844557.5 2947324.2 407556.6
127 128 129 130 131 132 133
825951.6 1757610.8 17344690.0 1679538.3 2161094.8 5913745.0 1058384.3
134 135 136 137 138 139 140
7738514.2 561868.8 1386779.3 7276857.5 1834723.0 556354.7 2416013.3